home *** CD-ROM | disk | FTP | other *** search
/ Die Ultimative Software-P…i Collection 1996 & 1997 / Die Ultimative Software-Pakete CD-ROM fur Atari Collection 1996 & 1997.iso / tt / only_tt.acc / listings / scrsav_h.lst next >
Encoding:
File List  |  1996-09-18  |  4.5 KB  |  203 lines
  1. $m20480
  2. vers$=" ScrSav_H.GFA,Pfr.S.Just,6936 Haag,TT_Mono:1280*960,GFABasic3.5E "
  3. '
  4. @init
  5. blink_version!=TRUE
  6. @schleife
  7. '
  8. PROCEDURE schleife
  9.   IF ap_id&=als_prog& THEN
  10.     DO
  11.       ~EVNT_TIMER(warte_sek%)
  12.       @abfrage
  13.       EXIT IF abbruch!
  14.     LOOP
  15.     END
  16.   ELSE ! Accessory
  17.     IF NOT geht! THEN
  18.       DO
  19.         ~EVNT_TIMER(-1)
  20.       LOOP
  21.     ELSE
  22.       PRINT
  23.       PRINT " *** ScrnSave-Accessory für TT-High-Monochrom v.Pfr.S.Just,Haag, GFABasic 3.5E, Blinkend ***"
  24.       me_id&=MENU_REGISTER(ap_id&,"  ScrnSave 1280*960 ")
  25.       DO
  26.         rueck&=EVNT_MULTI(&X110000,0,0,0,0,0,0,0,0,0,0,0,0,0,buffer%,warte_sek%,mx&,my&,button&,kstate&,key&,geklickt&)
  27.         IF rueck&=&X100000 THEN ! Timer
  28.           @abfrage
  29.         ELSE
  30.           IF buff&(1)=ac_open& THEN
  31.             @parameter
  32.           ENDIF
  33.         ENDIF
  34.       LOOP
  35.     ENDIF
  36.     ' Kein END
  37.   ENDIF
  38. RETURN ! schleife
  39. '
  40. PROCEDURE init
  41.   ap_id&=APPL_INIT()
  42.   als_prog&=0
  43.   debug!=(ap_id&=als_prog&)
  44.   geht!=(WORK_OUT(0)=1279) AND (WORK_OUT(1)=959)
  45.   t_puf_tab_adr%=XBIOS(14,1)
  46.   t_puf_adr%={t_puf_tab_adr%}
  47.   t_puf_len%=INT{t_puf_tab_adr%+4}
  48.   DIM buff&(16)
  49.   buffer%=V:buff&(1)
  50.   ac_open&=40
  51.   DATA 20,6F,00,04,20,2F,00,08,46,98,51,C8,FF,FC,4E,75
  52.   INLINE invert%,16
  53.   IF debug! THEN
  54.     FOR i%=0 TO 15
  55.       READ h$
  56.       BYTE{invert%+i%}=VAL("&h"+h$)
  57.     NEXT i%
  58.   ENDIF
  59.   DATA 20,6F,00,04,20,2F,00,08,22,3C,FF,FF,FF,FF,20,C1
  60.   DATA 51,C8,FF,FC,4E,75
  61.   INLINE dark_l%,22
  62.   IF debug! THEN
  63.     FOR i%=0 TO 21
  64.       READ h$
  65.       BYTE{dark_l%+i%}=VAL("&H"+h$)
  66.     NEXT i%
  67.   ENDIF
  68.   INLINE men_buf%,3072
  69.   men_bytes%=MIN(19*160,3072)
  70.   neu$=STRING$(t_puf_len%,CHR$(0))
  71.   old$=STRING$(t_puf_len%,CHR$(0))
  72.   mx%=0
  73.   my%=0
  74.   old_mx%=mx%
  75.   old_my%=my%
  76.   tm%=0
  77.   t%=0
  78.   invers!=FALSE
  79.   abbruch!=FALSE
  80.   cltoeol$=CHR$(27)+"K"
  81.   inv$=CHR$(27)+"p"
  82.   norm$=CHR$(27)+"q"
  83.   ' msec fuer das Warten
  84.   IF debug! THEN
  85.     warte_sek%=5*1000
  86.   ELSE
  87.     warte_sek%=60*1000
  88.   ENDIF
  89.   ' 1/200 sec fuer das Blinken
  90.   blink_f%=3*200
  91. RETURN ! init
  92. '
  93. PROCEDURE parameter
  94.   LOCAL w$,w%
  95.   @rette_menu
  96.   PRINT AT(1,1);cltoeol$;inv$;vers$;" Bisherige Zeitspanne: ";warte_sek% DIV 1000;" sec, Neuer Wert: ";
  97.   INPUT "",w$
  98.   w%=VAL(w$)
  99.   IF w%>0 THEN
  100.     warte_sek%=w%*1000
  101.   ENDIF
  102.   PRINT AT(1,1);cltoeol$;inv$;" Bisheriger Modus: ";
  103.   IF blink_version! THEN
  104.     PRINT "Periodische Bildschirm-Invertierung";
  105.   ELSE
  106.     PRINT "Dunkelschaltung";
  107.   ENDIF
  108.   PRINT " Neuer Modus: B-linkend D-unkel ";norm$;
  109.   IF UPPER$(INPUT$(1))="D" THEN
  110.     blink_version!=FALSE
  111.   ELSE
  112.     blink_version!=TRUE
  113.   ENDIF
  114.   @restore_menu
  115. RETURN ! parameter
  116. '
  117. PROCEDURE abfrage
  118.   mx%=MOUSEX
  119.   my%=MOUSEY
  120.   x!=(ABS(SUB(mx%,old_mx%))<8) ! Damit nicht bei jedem
  121.   y!=(ABS(SUB(my%,old_my%))<16)! kleinen Stoss
  122.   t!=@tbuf_gleich
  123.   IF debug! THEN
  124.     PRINT "x!=";x!;" y!=";y!;" t!=";t!
  125.   ENDIF
  126.   IF x! AND y! AND t! THEN
  127.     IF debug! THEN
  128.       PRINT " Aktiviert!"
  129.     ENDIF
  130.     tm%=LPEEK(&H4BA)
  131.     t%=0
  132.     mk%=0
  133.     old_mx%=mx%
  134.     old_my%=my%
  135.     invers!=FALSE
  136.     {XBIOS(14,1)+6}=0 ! Tastaturpuffer 'Loeschen'
  137.     IF NOT blink_version! THEN
  138.       HIDEM ! Sonst Maus-'Fleck'!
  139.       @rette_menu
  140.       @clr_scrn
  141.     ENDIF
  142.     REPEAT
  143.       t%=GEMDOS(6,&HFF) ! Notwendig zum Abbruch in der PRG-Version!
  144.       t!=(t%>0)
  145.       mx%=MOUSEX
  146.       x!=(ABS(SUB(mx%,old_mx%))>8)
  147.       my%=MOUSEY
  148.       y!=(ABS(SUB(my%,old_my%))>16)
  149.       IF blink_version! THEN
  150.         IF (SUB(LPEEK(&H4BA),tm%) MOD blink_f%)=0 THEN
  151.           @invert
  152.         ENDIF
  153.       ENDIF
  154.     UNTIL t! OR x! OR y!
  155.     IF (t% AND &HFF)=ASC("X") THEN
  156.       abbruch!=TRUE
  157.     ENDIF
  158.     IF blink_version! THEN
  159.       IF invers! THEN ! Bildschirm in der invertierten Form
  160.         @invert       ! 'erwischt'?
  161.       ENDIF
  162.     ELSE
  163.       @restore_menu ! Macht FORM_DIAL nicht!
  164.       ~FORM_DIAL(3,0,0,0,0,0,19,1280,960)
  165.       SHOWM
  166.     ENDIF
  167.   ENDIF
  168.   IF debug! THEN
  169.     PRINT " De-Aktiviert"
  170.   ENDIF
  171.   old_mx%=mx%
  172.   old_my%=my%
  173.   old$=neu$
  174.   t_puf_adr%={XBIOS(14,1)}
  175. RETURN ! abfrage
  176. '
  177. PROCEDURE rette_menu
  178.   BMOVE XBIOS(2),men_buf%,men_bytes%
  179. RETURN ! rette_menu
  180. PROCEDURE restore_menu
  181.   BMOVE men_buf%,XBIOS(2),men_bytes%
  182. RETURN ! rette_menu
  183. '
  184. FUNCTION tbuf_gleich
  185.   BMOVE t_puf_adr%,V:neu$,t_puf_len%
  186.   IF neu$=old$ THEN
  187.     RETURN TRUE
  188.   ELSE
  189.     RETURN FALSE
  190.   ENDIF
  191. ENDFUNC
  192. '
  193. PROCEDURE invert
  194.   invers!=NOT invers!
  195.   HIDEM
  196.   ~C:invert%(L:XBIOS(2),L:153600 DIV 4)
  197.   SHOWM
  198. RETURN ! invert
  199. PROCEDURE clr_scrn
  200.   ~C:dark_l%(L:XBIOS(2),L:153600 DIV 4)
  201. RETURN ! clr_scrn
  202. '
  203.